home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Module source / AlertQ < prev    next >
Text File  |  1990-12-22  |  2KB  |  78 lines
  1. \ More Mac like alternative to abort"
  2. \  8/21/86  cdn for Yerk v2.0
  3.  
  4. :Module AlertMod
  5.  
  6. :CLASS Alert  <Super X-Array 
  7.   int resID
  8.   int type     \ 0=caution, 1=note, 2=stop
  9.  
  10. ( -- )  ( display the alert and execute the item )
  11.  :M SHOW: word0  int: resID 0 get: type
  12.    CASE  
  13.        0  OF  call cautionALert  ENDOF
  14.        1  OF  call noteAlert     ENDOF 
  15.        2  OF  call stopAlert     ENDOF
  16.     drop call Alert 0
  17.    ENDCASE  
  18.      i->l dup 0>
  19.      IF  1-  exec: super 
  20.      ELSE  drop 
  21.      THEN   ;M
  22.  
  23.  :M INIT:  put: type  put: resid   ;M
  24.  
  25.     \ ( resID type -- )  Combined actions of init: & show:
  26.     :M  DISP:   init: self  show: self ;M
  27.  
  28. ;CLASS
  29.  
  30. 0 Variable tALRT here +base tALRT !
  31. \ t,l,b,r,resID,stage attrs
  32.     100 w, 51 w, 191 w, 462 w, 0 w, $ 7fff w,
  33.  
  34. 0 Variable tDITL here +base tDITL !
  35.     2 w,    \ # items-1
  36. \ placeholder,t,l,b,r,attrs,length,data
  37.     0,  58 w, 177 w,  80 w, 234 w,   4 c, 2 c, 'type ..OK w,
  38.     0,  60 w, 355 w,  81 w, 393 w, 136 c, 4 c, 'type 0000 ,
  39.     0,  10 w,  76 w,  42 w, 393 w, 136 c,
  40.  
  41. 3 Alert Alrt
  42.  
  43. \ ( RC type str255 -- )  Display alert using message saved in-line
  44. : (Al") { RC type Astr -- }
  45. \    RC    \ Display the Alert if code is non-zero
  46. \    IF    \ build ALRT from scratch
  47.             12 newHandle        
  48.             dup 'type ALRT word0 nullOSstr call AddResource
  49.             >ptr tALRT 4+ swap 12 cMove
  50.         \ build DITL from scratch
  51.             Astr dup c@ align 50 + newHandle
  52.             dup 'type DITL word0 nullOSstr call AddResource
  53.             tDITL 36 + 4 blanks
  54.             RC s->d swap over dabs <# #s sign #> tDITL 36 + swap 4 min cMove
  55.             >ptr tDITL 4+ over 49 cMove
  56.             49 + over c@ 1+ cMove
  57.         arrowcurs
  58.         0 type disp: alrt
  59.         0 GetRes ALRT dup call RmveResource call ReleaseResource
  60.         0 GetRes DITL dup call RmveResource call ReleaseResource
  61.         type 0 max 3 min exec: Aact
  62. \    THEN
  63. ;
  64.  
  65. : three 3 ;
  66.  
  67. 4 alert me
  68.  
  69. \ text is last, there can be up to 4 buttons.  Each button will return
  70. \ its number.  The first item should be the default button requiring no
  71. \ action - a zero is returned.  
  72. 4 'cfas three 2 1 0 0 to: me 1 to: me 2 to: me 3 to: me
  73.  
  74. : alert! init: me arrowcurs show: me ;
  75.  
  76.  
  77. ;Module
  78.